home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Open Prolog 1.0.3d23 / Samples / router < prev    next >
Encoding:
Text File  |  1994-04-18  |  3.5 KB  |  152 lines  |  [TEXT/PRLG]
  1. %This code implements Lees (?) Algorithm for searching for a route on a PCB
  2. %sample call: eraseBoard,drawCircuitBoard,drawSearch(p(9,7),p(10,15)).
  3.  
  4.  
  5. :- op(10,xfy,:).
  6.  
  7. %specification of the sample board and its sample components
  8. board(0:0-40:60). %co-ordinates as in Mac - Top:Left-Bottom:Right
  9.  
  10. %components
  11. component(2:4-6:8).
  12. component(8:8-13:13).
  13. component(12:3-16:5).
  14. component(10:16-11:28).
  15.  
  16.  
  17. %setup constants for drawing
  18. magnification(7,7).
  19. offset(3,40).
  20. colour(component,5). %green
  21.  
  22. %colours 0-7 below
  23. %black,yellow,magenta,red,cyan,green,blue,white
  24.  
  25.  
  26. %assume 1 unit grid
  27. %points: p(X,Y)
  28.  
  29. %main routine
  30. drawSearch(A,B) :-
  31.         drawPoint(A,0,5),
  32.         drawPoint(A,0,3),
  33.         drawPoint(B,0,5),
  34.         pathFind(0,[A],B,X-[0-[A]]),!,
  35.         retracePath(X,B).
  36.  
  37. pathFind(C,P,D,X-X) :-
  38.         member(D,P).
  39. pathFind(C,Pl,D,G-[Co-Lo|H]) :-
  40.         C1 is C+1,
  41.         getMoves(Pl,L,Lo),
  42.         drawPoints(L,C1,3),!,
  43.         pathFind(C1,L,D,G-[C-Pl,Co-Lo|H]).
  44.  
  45. getMoves([],[],Ex).
  46. getMoves([P|R],[N|X],Ex) :-
  47.         move(P,N),
  48.         not member(N,Ex),!,
  49.         getMoves([P|R],X,[N|Ex]).
  50. getMoves([P|R],X,Ex) :-
  51.         getMoves(R,X,[P|Ex]).
  52.  
  53. move(p(X,Y),p(X1,Y)) :- X1 is X+1,legal(X1,Y).
  54. move(p(X,Y),p(X1,Y)) :- X1 is X-1,legal(X1,Y).
  55. move(p(X,Y),p(X,Y1)) :- Y1 is Y+1,legal(X,Y1).
  56. move(p(X,Y),p(X,Y1)) :- Y1 is Y-1,legal(X,Y1).
  57.  
  58. legal(X,Y) :- board(T:L-B:R),X>=L,X=<R,Y>=T,Y=<B,not inComponent(X,Y).
  59.  
  60. %retrace & draw path found
  61. retracePath([_-[X]],X).
  62. retracePath([_-L|R],P) :-
  63.         member(C,L),move(P,C),drawLine(P,C),
  64.         retracePath(R,C).
  65.  
  66. %some drawing stuff
  67. drawCircuitBoard :-
  68.         board(Board),
  69.         drawBoard(Board),
  70.         drawComponents.
  71. drawComponents :-
  72.        component(Component),
  73.        drawComponent(Component),fail.
  74. drawComponents.
  75.  
  76.  
  77. drawBoard(Top:Left-Bottom:Right) :-
  78.         magnification(ByX,ByY),
  79.         offset(Xo,Yo),
  80.         T is Top*ByY+Yo,
  81.         L is Left*ByX+Xo,
  82.         B is Bottom*ByY+Yo,
  83.         R is Right*ByX+Xo,
  84.         draw(1,'The Board'(T,L,B,R),_).
  85.  
  86. eraseBoard :-
  87.         draw(2,_,_).
  88.  
  89. drawComponent(Top:Left-Bottom:Right) :-
  90.         magnification(ByX,ByY),
  91.         T is Top*ByY,
  92.         L is Left*ByX,
  93.         B is Bottom*ByY,
  94.         R is Right*ByX,
  95.         colour(component,C),
  96.         draw(9,color(C),_),
  97.         draw(4,rect(L,T,R,B),_).
  98.  
  99. drawPoint(p(X,Y),C,Size) :-
  100.         magnification(ByX,ByY),
  101.         Delta is Size/2,
  102.         T is Y*ByY-Delta,
  103.         L is X*ByX-Delta,
  104.         B is T+Size,
  105.         R is L+Size,
  106.         Cl is C mod 7,
  107.         draw(9,color(Cl),_),
  108.         draw(4,rect(L,T,R,B),_).
  109.  
  110. drawLines([p(X1,Y1),p(X2,Y2)|Rest],C) :-
  111.         !,
  112.         magnification(ByX,ByY),
  113.         T is Y1*ByY-1,
  114.         L is X1*ByX-1,
  115.         B is T+3,
  116.         R is L+3,
  117.         Cl is C mod 6,
  118.         draw(9,color(Cl),_),
  119.         draw(4,rect(L,T,R,B),_),
  120.         T2 is Y2*ByY-1,
  121.         L2 is X2*ByX-1,
  122.         B2 is T2+3,
  123.         R2 is L2+3,
  124.         Xs is L+1,Ys is T+1,
  125.         Xe is L2+1,Ye is T2+1,
  126.         draw(4,rect(L2,T2,R2,B2),_),
  127.         draw(3,line(Xs,Ys,Xe,Ye),_),
  128.         drawLines([p(X2,Y2)|Rest],C).
  129. drawLines(_,_).
  130.  
  131. drawLine(p(X1,Y1),p(X2,Y2)) :-
  132.         magnification(ByX,ByY),
  133.         T is Y1*ByY,
  134.         L is X1*ByX,
  135.         T2 is Y2*ByY,
  136.         L2 is X2*ByX,
  137.         draw(3,line(L,T,L2,T2),_).
  138.  
  139. drawPoints([],_,_).
  140. drawPoints([X|Y],C,S) :- drawPoint(X,C,S),drawPoints(Y,C,S).
  141.  
  142. %some utilities
  143.  
  144. inComponent(X,Y) :-component(T:L-B:R),X>=L,X=<R,Y>=T,Y=<B.
  145.  
  146. member(X,[X|_]).
  147. member(X,[_|R]) :- member(X,R).
  148.  
  149. append([],X,X).
  150. append([X|Y],Z,[X|R]) :- append(Y,Z,R).
  151.  
  152.